home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 9 / FM Towns Free Software Collection 9.iso / t_os / tool / tmsuper / tmsuper.bas < prev    next >
Encoding:
BASIC Source File  |  1994-11-16  |  29.6 KB  |  1,020 lines

  1. 10  'SUPER TMENUEX V4  GOMBEH SOFT 1994 ; BY SAORI
  2. 20  'T%(0)=----  T%(1)=DRIVE  T%(2)=FLASH T%(3)=NOMB
  3. 30  GOSUB *WIN:PLAY OFF
  4. 40  'INDR$="D:\TMENUEX\":CLS
  5. 50  RANDOMIZE TIME:ON ERROR GOTO *ERTRP
  6. 60  '
  7. 70  DIM C%(64*40*30),D%(64*48),Y%(4,1),JJJ%(63),JJJJ%(63),JJRR%(63)
  8. 80  DIM MOU%(63),SORJJ%(63),GOMBJ%(63),GOMBJJ%(63),HAAI%(7999),T%(3)
  9. 90  DIM EMIT%(63),EMITR%(63)
  10. 100  AABB=64:MDNB=1:SUZITA=70:ZYOUTAI=1:JUNK=1
  11. 110  '
  12. 120  DATF=1
  13. 130  LOAD@ INDR$ + "TMSAVE.DAT",T%
  14. 140  DATF=0
  15. 150  '
  16. 160  FLASH=T%(2)
  17. 170  GOSUB *SOUSUB:GOSUB *GRASUB
  18. 180  LINE (0,0)-(319,239),PSET,,BF:DIM B%(320*240)
  19. 190  '
  20. 200  MOUSE 0:MOUSE 3,0,10:MOUSE 3,1,10
  21. 210  '
  22. 220  GOSUB *SUPERT:SYMBOL (98,120),"TMENUEX V4",3/2,3/4,[0,200,190],,,5
  23. 230  SYMBOL (98,140),"GOMBEH SOFT 1994",1,1/2,[220,245,255],,,4
  24. 240  GOSUB *GRASUB2:GOSUB *NEKO:SAOX=136:SAOY=58
  25. 250  GOSUB *SAOPUT:GOSUB *ONSUB:WAIT 35:GOSUB *SAOBPUT:WAIT 20
  26. 260  IF DATF=2 THEN GOSUB *SETTEI
  27. 270  '
  28. 280  A=T%(3)
  29. 290  '
  30. 300  OUTDR$=MID$("ABCDEFGHIJ",T%(1),1)
  31. 310  '
  32. 320  LOAD@ INDR$+"TMENU"+RIGHT$(STR$(101+A),2)+".TIF"
  33. 330  GOSUB *GETSUB 
  34. 340  WAIT 20
  35. 350  IF JJJ%(A) - 2 THEN AABB=A
  36. 360  GOSUB *LINEW
  37. 370  IF KETTEIR THEN GOSUB *MINIW : KETTEIR=0
  38. 380  GOSUB *PUB
  39. 390  '
  40. 400  GOSUB *SAT
  41. 410  GOSUB *WM10:MOUSE 1,SAOX+5,SAOY+10,1
  42. 420  '
  43. 430  KETTEIS=0:PCFX=0:ALLCUT=0:BING=0:GOSUB *MASU
  44. 440  '
  45. 450  IF SVFLG THEN 770
  46. 460  RANFL=MOUSE(2,1) : RANSW=0 : SORGO=0 : RANGO=0 
  47. 470  WHILE RANFL
  48. 480   RANSW=RANSW + 1
  49. 490   IF MOUSE(2,0) THEN
  50. 500    RANFL=0 : SORGO=-1
  51. 510    GOTO 590
  52. 520   ELSE
  53. 530   ENDIF
  54. 540   IF RANSW > 70 THEN
  55. 550    RANFL=0 : RANGO=-1 
  56. 560   ELSE 
  57. 570    RANFL=MOUSE(2,1)
  58. 580   ENDIF
  59. 590  WAIT 1
  60. 600  WEND
  61. 610  '
  62. 620  IF SORGO THEN GOSUB *SORSUB
  63. 630  IF RANGO THEN GOSUB *RANSUB
  64. 640  '
  65. 650  IF (KETTEIS-1)*(PCFX+1)=0 THEN 430
  66. 660  IF KETTEIR THEN 330 
  67. 670  '
  68. 680  ALLVF=0
  69. 690  WHILE ALLVF < 50
  70. 700    IF MOUSE(2,1) THEN ALLVF=101
  71. 710    ALLVF=ALLVF+1 : WAIT 1
  72. 720  WEND
  73. 730  GOSUB *WM10
  74. 740  IF ALLVF > 100 THEN GOSUB *ALLVW
  75. 750  '
  76. 760  IF ALLCUT THEN 430
  77. 770  '
  78. 780  KILBN=1
  79. 790  KILL INDR$ + "TMSAVE.DAT"
  80. 800  KILBN=0
  81. 810  '
  82. 820  T%(2)=FLASH:SAVE@ INDR$ + "TMSAVE.DAT",T%
  83. 830  IF SVFLG THEN 
  84. 840    '
  85. 850    KILBN=1
  86. 860    KILL OUTDR$ + ":\TMENU.TIF"
  87. 870    KILBN=0
  88. 880    '
  89. 890    IF JJJJ%(A) THEN
  90. 900     SAVE@ OUTDR$ + ":\TMENU.TIF",(0,0)-(639,479),1,BM1
  91. 910    ELSE
  92. 920     SAVE@ OUTDR$ + ":\TMENU.TIF",(0,0)-(319,239),,BM1
  93. 930    ENDIF
  94. 940  ELSE
  95. 950  ENDIF 
  96. 960  GOSUB *WM10:SAOX=136:SAOY=62:IF MDNB=0 THEN GOSUB *WIN
  97. 970  LINE (0,0)-(319,239),PSET,,BF
  98. 980  SYMBOL (71,117),"SEE YOU AGAIN!!",3/2,3/4,[0,230,190],,,5
  99. 990  GOSUB *SAOPUT:WAIT 35:GOSUB *SAOBPUT:WAIT 85
  100. 1000  MOUSE 5
  101. 1010  '
  102. 1020  PLAY OFF:END
  103. 1030  '
  104. 1040 *SUPERT
  105. 1050  FOR N=1 TO 5
  106. 1060    SYMBOL (N*45,45),MID$("SUPER",N,1),6,8,[0,230,190],,,1
  107. 1070    GOSUB *HAAIS:WAIT 20
  108. 1080  NEXT
  109. 1090  RETURN
  110. 1100  '
  111. 1110 *W1
  112. 1120  GOSUB *FSUB:WAIT 1:RETURN
  113. 1130  '
  114. 1140 *WIN
  115. 1150  SCREEN@ 1:VIEW(0,0)-(511,239):WINDOW (0,0)-(511,239)
  116. 1160  GOSUB *COLS:RETURN
  117. 1170  '
  118. 1180 *WM10
  119. 1190  WHILE MOUSE(2,0)+MOUSE(2,1):GOSUB *FSUB:WEND:RETURN
  120. 1200  '
  121. 1210 *WM20
  122. 1220  WHILE MOUSE(2,0)+MOUSE(2,1)=0:GOSUB *FSUB:WEND:RETURN
  123. 1230  '
  124. 1240 *MOU3
  125. 1250  N=MOUSE(3,0):N=MOUSE(3,1):RETURN
  126. 1260  '
  127. 1270 *GRASUB
  128. 1280  DIM MSA1%(64),MSD1%(32*32)
  129. 1290  GRAFL=1
  130. 1300  GOSUB *LDSUB
  131. 1310  IF GRAFL=2 THEN 1370
  132. 1320  GRAFL=0
  133. 1330  DIM MSA2%(64),MSD2%(32*32),MSA3%(64),MSD3%(32*32)
  134. 1340  DIM MSA4%(64),MSD4%(32*32),MSA5%(64),MSD5%(32*32)
  135. 1350  DIM MSA6%(64),MSD6%(32*32),MSA7%(64),MSD7%(32*32)
  136. 1360  DIM SAO%(48*50+32*12+6*14)
  137. 1370  '
  138. 1380  RETURN
  139. 1390  '
  140. 1400 *LDSUB
  141. 1410  FLASHF=1
  142. 1420  LOAD@ INDR$+"TM"+MID$("123",FLASH+1,1)+".TIF",(320,0)
  143. 1430  GET@A (370,111)-(370,111),GOMBJJ%:F=GOMBJJ%(0) AND &H7FFF
  144. 1440  F14=F AND 31:F=F \ 32
  145. 1450  F15=F AND 31:F=F \ 32
  146. 1460  F16=F AND 31
  147. 1470  GOSUB *COLS:FLASHF=0:RETURN
  148. 1480  '
  149. 1490 *COLS
  150. 1500  COLOR ,,[F16*256\32,F15*256\32,F14*256\32]:RETURN
  151. 1510  '
  152. 1520 *GRASUB2
  153. 1530  IF GRAFL=2 THEN 1620
  154. 1540  GET@ (352,0)-(383,31),MSA2%,0:GET@A (352,0)-(383,31),MSD2%
  155. 1550  GET@ (384,0)-(415,31),MSA3%,0:GET@A (384,0)-(415,31),MSD3%
  156. 1560  GET@ (320,32)-(351,63),MSA4%,0:GET@A (320,32)-(351,63),MSD4%
  157. 1570  GET@ (352,32)-(383,63),MSA5%,0:GET@A (352,32)-(383,63),MSD5%
  158. 1580  GET@ (384,32)-(415,63),MSA6%,0:GET@A (384,32)-(415,63),MSD6%
  159. 1590  GET@ (384,80)-(415,111),MSA7%,0:GET@A (384,80)-(415,111),MSD7%
  160. 1600  GET@A (320,64)-(369,111),SAO%:GET@A (370,64)-(401,75),SAO%,48*50
  161. 1610  GET@A (402,64)-(415,69),SAO%,48*50+32*12
  162. 1620  GET@ (320,0)-(351,31),MSA1%,0:GET@A (320,0)-(351,31),MSD1%:RETURN
  163. 1630  '
  164. 1640 *SOUSUB
  165. 1650  SOUFL=1
  166. 1660  LOAD@ INDR$ + "TM.BOX",HAAI%
  167. 1670  SOUFL=0
  168. 1680  YB=HAAI%(0)-13*HAAI%(3)+9
  169. 1690  DIM M$(3,3)
  170. 1700  FOR N=2 TO HAAI%(3)
  171. 1710    FOR XB=4 TO 16:GOMBJ%(XB)=HAAI%(YB+XB):NEXT
  172. 1720    VOICE N,GOMBJ%:YB=YB+13
  173. 1730  NEXT
  174. 1740  RETURN
  175. 1750  '
  176. 1760 *FSUB
  177. 1770  IF (SOUFL-2)*(PLAY(0)+1)=0 THEN 1790
  178. 1780  PLAY ,M$(3,0):GOSUB *PLAYSUB
  179. 1790  RETURN
  180. 1800  '
  181. 1810 *PLAYSUB
  182. 1820  FOR F=0 TO A10
  183. 1830    PLAY M$(1,0),M$(1,1),M$(1,2),M$(1,3)
  184. 1840  NEXT
  185. 1850  PLAY M$(2,0),M$(2,1),M$(2,2),M$(2,3)
  186. 1860  PLAY ,M$(3,1),M$(3,2),M$(3,3):RETURN
  187. 1870  '
  188. 1880 *ONSUB
  189. 1890  IF SOUFL=2 THEN 2010
  190. 1900  S=HAAI%(FLASH):A10=HAAI%(S):S=S+1
  191. 1910  FOR AA0=0 TO 3
  192. 1920    FOR F=0 TO 3
  193. 1930      M$(F,AA0)="":S$=MKI$(HAAI%(S))
  194. 1940      WHILE S$ <> " Z"
  195. 1950        M$(F,AA0)=M$(F,AA0)+S$:S=S+1:S$=MKI$(HAAI%(S))
  196. 1960      WEND
  197. 1970      S=S+1
  198. 1980    NEXT
  199. 1990  NEXT
  200. 2000  PLAY M$(0,0),M$(0,1),M$(0,2),M$(0,3):GOSUB *PLAYSUB
  201. 2010  RETURN
  202. 2020  '
  203. 2030 *SAOPUT
  204. 2040  IF GRAFL=2 THEN 2060
  205. 2050  PUT@A (SAOX,SAOY)-(SAOX+49,SAOY+47),SAO%,MATTE,,,[0,0,0]
  206. 2060  RETURN
  207. 2070  '
  208. 2080 *SAOBPUT
  209. 2090  IF GRAFL=2 THEN 2110
  210. 2100  PUT@A (SAOX,SAOY+21)-(SAOX+31,SAOY+32),SAO%,MATTE,,,[0,0,0],48*50
  211. 2110  GOSUB *HAAIS:RETURN
  212. 2120  '
  213. 2130 *SAOB2PUT
  214. 2140  IF GRAFL=2 THEN 2160
  215. 2150  PUT@A (SAOX+18,SAOY+21)-(SAOX+31,SAOY+26),SAO%,MATTE,,,[0,0,0],48*50+32*12
  216. 2160  RETURN
  217. 2170  '
  218. 2180 *HAAIS
  219. 2190  IF SOUFL=2 THEN
  220. 2200     PLAY OFF:PLAY "@1O6C16"
  221. 2210  ELSE
  222. 2220     PCMPLAY HAAI%
  223. 2230  ENDIF
  224. 2240  RETURN
  225. 2250  '
  226. 2260 *ZYOUTAIS
  227. 2270  IF GRAFL=2 THEN
  228. 2280    IF ABS(MOUSE(9))+ABS(MOUSE(10)) THEN BING=0
  229. 2290    GOTO 2580
  230. 2300  ELSE
  231. 2310  ENDIF
  232. 2320  NUKU=NUKU+1
  233. 2330  ZYOX=MOUSE(0):ZYOY=MOUSE(1):ZYOXX=OZYOX-ZYOX:ZYOYY=OZYOY-ZYOY
  234. 2340  OZYOX=ZYOX:OZYOY=ZYOY
  235. 2350  IF JUNK THEN
  236. 2360    HIDA=0:MIGI=0:ZYOUTAI=1:JUNK=0:NUKUNUKU=0
  237. 2370  ELSE
  238. 2380    IF (ZYOXX > 0) OR ((ZYOXX=0) AND (ZYOYY <> 0)) THEN MIGI=MIGI+1
  239. 2390    IF ZYOXX < 0 THEN HIDA=HIDA+1
  240. 2400    NUKUNUKU=NUKUNUKU+1
  241. 2410    IF NUKUNUKU > 2 THEN
  242. 2420      IF MIGI+HIDA=0 AND (ZYOUTAI-1)*(ZYOUTAI-2) <> 0 THEN
  243. 2430         ZYOUTAI=1:MOUSE 6,1,MSA1%,MSD1%:NUKU=0
  244. 2440      ELSE
  245. 2450      ENDIF
  246. 2460      IF MIGI*(MIGI-HIDA)>0 AND (ZYOUTAI-3)*(ZYOUTAI-4) <> 0 THEN
  247. 2470        ZYOUTAI=3:MOUSE 6,1,MSA3%,MSD3%:NUKU=0:BING=0
  248. 2480      ELSE
  249. 2490      ENDIF
  250. 2500      IF HIDA*(HIDA-MIGI)>0 AND (ZYOUTAI-5)*(ZYOUTAI-6) <> 0 THEN
  251. 2510        ZYOUTAI=5:MOUSE 6,1,MSA5%,MSD5%:NUKU=0:BING=0
  252. 2520      ELSE
  253. 2530      ENDIF
  254. 2540        HIDA=0:MIGI=0:NUKUNUKU=0
  255. 2550    ELSE
  256. 2560    ENDIF
  257. 2570  ENDIF
  258. 2580  RETURN
  259. 2590  '
  260. 2600 *YUSASUB
  261. 2610  IF GRAFL=2 THEN 2670
  262. 2620  IF NUKU < 26 THEN 2650
  263. 2630  ON ZYOUTAI GOSUB *SUB1,*SUB2,*SUB3,*SUB4,*SUB5,*SUB6
  264. 2640  GOTO 2670
  265. 2650  IF NUKU < 8 THEN 2670
  266. 2660  ON ZYOUTAI GOSUB *SUB7,*SUB7,*SUB3,*SUB4,*SUB5,*SUB6
  267. 2670  RETURN
  268. 2680 *SUB1
  269. 2690  IF RND < 1/6 THEN
  270. 2700   MOUSE 6,1,MSA7%,MSD7%:GOSUB *DOG:NUKU=-INT(RND*5)*52
  271. 2710  ELSE
  272. 2720   MOUSE 6,1,MSA2%,MSD2%:GOSUB *DOG
  273. 2730  ENDIF
  274. 2740  ZYOUTAI=2:RETURN
  275. 2750 *SUB2
  276. 2760  MOUSE 6,1,MSA1%,MSD1%:GOSUB *DOG:ZYOUTAI=1:RETURN
  277. 2770 *SUB3
  278. 2780  MOUSE 6,1,MSA4%,MSD4%:GOSUB *DOG:ZYOUTAI=4:RETURN
  279. 2790 *SUB4
  280. 2800  MOUSE 6,1,MSA3%,MSD3%:GOSUB *DOG:ZYOUTAI=3:RETURN
  281. 2810 *SUB5
  282. 2820  MOUSE 6,1,MSA6%,MSD6%:GOSUB *DOG:ZYOUTAI=6:RETURN
  283. 2830 *SUB6
  284. 2840  MOUSE 6,1,MSA5%,MSD5%:GOSUB *DOG:ZYOUTAI=5:RETURN
  285. 2850 *SUB7
  286. 2860  RETURN
  287. 2870  '
  288. 2880 *DOG
  289. 2890  NUKU=0:NUKUNUKU=0:MIGI=0:HIDA=0:RETURN
  290. 2900  '
  291. 2910 *GETSUB
  292. 2920  IF MDNB THEN
  293. 2930    GET@A (0,0)-(319,239),B%
  294. 2940  ELSE
  295. 2950    GET@A (0,0)-(639,479),B%
  296. 2960  ENDIF
  297. 2970  RETURN
  298. 2980  '
  299. 2990 *SAT
  300. 3000  SAOX=(A MOD 8)*40+20:SAOY=(A \ 8)*30+8:GOSUB *SAOH:RETURN
  301. 3010  '
  302. 3020 *KILLVIEW
  303. 3030  KILBN=1
  304. 3040  KILL INDR$ + "TMVIEWSP.TIF"
  305. 3050  KILBN=0
  306. 3060  RETURN
  307. 3070  '
  308. 3080 *VIEWTL
  309. 3090  GOSUB *WM10
  310. 3100  LINE (64*2,48*2)-(64*3-1,48*3-1),PSET,[190,230,230],BF
  311. 3110  SYMBOL (143,106),"VIEW",1,1/2,[150,200,200]
  312. 3120  SYMBOL (132,120),S$,2/3,1/2,[150,200,200]:GOSUB *HAAIS:RETURN
  313. 3130  '
  314. 3140 *PUTWL
  315. 3150  PUT@A (0,0)-(319,239),B%:GOSUB *LINEW:GOSUB *MINIW:RETURN
  316. 3160  '
  317. 3170 *VIEWSL
  318. 3180  S$="SAVE ? LOAD":GOSUB *VIEWTL
  319. 3190  SAOX=2
  320. 3200    WHILE SAOX=2
  321. 3210     GOSUB *W1
  322. 3220     IF MOUSE (2,0) THEN
  323. 3230       GOSUB *HAAIS:SAOX=0:GOSUB *AA0S
  324. 3240       IF AA0 < 100 THEN SAOX=1
  325. 3250       GSMS=1:MINIF=1:GOSUB *PUTWL:MINIF=0:GSMS=0
  326. 3260       FOR F=0 TO 63
  327. 3270         GOSUB *XYF:PSET (XB+37,YB+5),[0,0,0]
  328. 3280         IF (JJJ%(F)-1)*(EMIT%(F)-1) THEN
  329. 3290           IF SAOX=1 THEN LINE (XB,YB)-(XB+39,YB+29),PSET,[0,0,0],BF
  330. 3300         ELSE
  331. 3310           PSET (XB+37,YB+5),[0,0,10]
  332. 3320         ENDIF
  333. 3330       NEXT
  334. 3340       '
  335. 3350       GOSUB *KILLVIEW
  336. 3360       '
  337. 3370       VIEWFL=1
  338. 3380       SAVE@ INDR$ + "TMVIEWSP.TIF",(0,0)-(319,239),,SAOX
  339. 3390       IF VIEWFL=1 THEN 3440
  340. 3400         GOSUB *KILLVIEW
  341. 3410         S$="DISK OVER!!":GOSUB *VIEWTL
  342. 3420         WAIT 30:GOSUB *HAAIS
  343. 3430         GOSUB *WM20
  344. 3440       VIEWFL=0
  345. 3450     ELSE
  346. 3460     ENDIF
  347. 3470     IF MOUSE (2,1) THEN
  348. 3480       SAOX=0:GOSUB *HAAIS
  349. 3490       '
  350. 3500       VIFF=1
  351. 3510       LOAD@ INDR$ + "TMVIEWSP.TIF"
  352. 3520       GOSUB *WM20:GOSUB *HAAIS:GOSUB *WM10
  353. 3530       FOR F=0 TO 63
  354. 3540         GOSUB *XYF
  355. 3550         EMIT%(F)= - POINT(XB+37,YB+5)
  356. 3560         LINE (XB,YB)-(XB+39,YB+29),PSET,,B
  357. 3570         IF JJJ%(F)+ABS(EMIT%(F)-1)=0 THEN
  358. 3580           GET@A (XB,YB)-(XB+39,YB+29),C%,40*30*F
  359. 3590         ELSE
  360. 3600           EMIT%(F)=0
  361. 3610         ENDIF
  362. 3620       NEXT
  363. 3630       '
  364. 3640       VIFF=0
  365. 3650     ELSE
  366. 3660     ENDIF
  367. 3670    WEND
  368. 3680  GOSUB *PUTWL:GOSUB *WM10:GOSUB *NEKO:MOUSE 1,,,1:RETURN
  369. 3690  '
  370. 3700 *XYF
  371. 3710  XB=(F MOD 8)*40:YB=(F \ 8)*30:RETURN
  372. 3720  '
  373. 3730 *ALLVW
  374. 3740  GOSUB *AGET:N=0
  375. 3750  WHILE N < 51
  376. 3760   GOSUB *W1:N=N+1
  377. 3770   IF MOUSE(2,1) THEN
  378. 3780     SA=0:N=51
  379. 3790   ELSE
  380. 3800   ENDIF
  381. 3810   IF MOUSE(2,0) THEN N=100
  382. 3820  WEND
  383. 3830  IF N=100 THEN
  384. 3840    GOSUB *VIEWSL:GOTO 4090
  385. 3850  ELSE
  386. 3860  ENDIF
  387. 3870  GOSUB *WM10:GOSUB *MOU3:A=SA:GOSUB *SAT:WWW=0
  388. 3880  FOR A=SA TO 63
  389. 3890     IF ALLCUT THEN 4050
  390. 3900     IF JJJ%(A)=0 THEN
  391. 3910       SYMBOL (93,118),"ALL VIEWING",3/2,3/4,[180,245,255],,,5
  392. 3920       GOSUB *SAT:GOSUB *FSUB:GOSUB *SAOPUT:WAIT 10:GOSUB *SAOBPUT
  393. 3930       LOAD@ INDR$+"TMENU"+RIGHT$(STR$(101+A),2)+".TIF"
  394. 3940       IF JJJ%(A) - 2 THEN
  395. 3950         GOSUB *GETSUB:AABB=A
  396. 3960       ELSE
  397. 3970       ENDIF
  398. 3980       IF MOUSE(3,0) THEN WWW=1
  399. 3990       IF WWW THEN 4010
  400. 4000          GOSUB *LINEW:GOSUB *MINIW
  401. 4010       GOSUB *MODCH:GOSUB *PUB
  402. 4020     ELSE
  403. 4030     ENDIF
  404. 4040     IF MOUSE(3,1) THEN ALLCUT=1
  405. 4050     '
  406. 4060  NEXT
  407. 4070  GOSUB *WM10:IF WWW THEN GOSUB *PUTWL
  408. 4080  GOSUB *NEKO:MOUSE 1,SAOX+5,SAOY+10,1
  409. 4090  ALLCUT=1:RETURN
  410. 4100  '
  411. 4110 *AA0S
  412. 4120  AA0=0
  413. 4130  WHILE AA0 < 75
  414. 4140    GOSUB *W1:AA0=AA0+1
  415. 4150    IF MOUSE(2,0)=0 THEN AA0=100
  416. 4160  WEND
  417. 4170  RETURN
  418. 4180  '
  419. 4190 *AGET
  420. 4200  SA=(MOUSE(0) \ 40) + (MOUSE(1) \ 30)*8:RETURN
  421. 4210  '
  422. 4220 *SORSUB
  423. 4230  GOSUB *AGET:SPKOU=SA:GOSUB *AA0S
  424. 4240  SINRO=1:IF AA0 < 100 THEN SINRO=0
  425. 4250  '
  426. 4260  PUT@A (0,0)-(319,239),B%:SAOX=136:SAOY=103:GOSUB *SAOPUT
  427. 4270  '
  428. 4280  IF SINRO THEN
  429. 4290   SYMBOL (95,88),"RANDOM SORT",3/2,3/4,,,,5
  430. 4300  ELSE
  431. 4310   SYMBOL (91,88),"FORWARD PACK",3/2,3/4,,,,5
  432. 4320  ENDIF
  433. 4330  GET@A (64*2,48*3)-(64*2+63,48*3+47),D%
  434. 4340  SYMBOL (64*2+23,48*3+15),"64",5/4,5/10,,,,5:WAIT 30
  435. 4350  GOSUB *SAOBPUT:GOSUB *WM10:GOSUB *MOU3
  436. 4360  GOSUB *MOUSUB
  437. 4370  IF SINRO=0 THEN
  438. 4380    WAIT 35:GOTO 4490
  439. 4390  ELSE
  440. 4400  ENDIF
  441. 4410  FOR SI=0 TO 63
  442. 4420    SX=INT(RND*(64-SI)):WWW=-1
  443. 4430    FOR N=0 TO SX
  444. 4440      WWW=WWW+1:WHILE MOU%(WWW):WWW=WWW+1:WEND
  445. 4450    NEXT
  446. 4460    SORJJ%(SI)=WWW:MOU%(WWW)=1
  447. 4470  NEXT
  448. 4480  GOSUB *MOUSUB 
  449. 4490  FOR SI=0 TO 63
  450. 4500   IF JJJ%(SI)=2 THEN 
  451. 4510     MOU%(SI)=1:GOTO 4580
  452. 4520   ELSE
  453. 4530   ENDIF
  454. 4540   '
  455. 4550   SORFLG=1:WTMENUF=1
  456. 4560   NAME INDR$+"TMENU"+RIGHT$(STR$(101+SI),2)+".TIF" AS "WTMENU"+RIGHT$(STR$(101+SI),2)+".TIF"
  457. 4570   SORFLG=0:WTMENUF=0 
  458. 4580   '
  459. 4590   IF SI MOD 2 THEN 4620
  460. 4600   GOSUB *W1:PUT@A (64*2,48*3)-(64*2+63,48*3+47),D%
  461. 4610   SYMBOL (64*2+23,48*3+15),RIGHT$(STR$(163-SI/2),2),5/4,5/10,,,,5
  462. 4620  NEXT
  463. 4630  BACKF=0:IF SINRO THEN 4800
  464. 4640  SORM=0
  465. 4650  FOR SI=0 TO 63
  466. 4660    IF MOU%(SI)=0 THEN SORJJ%(SI)=SORM
  467. 4670    SORM=SORM+1-MOU%(SI)
  468. 4680  NEXT
  469. 4690  BACKF=MOUSE(3,1):IF BACKF < 2 THEN SPKOU=0
  470. 4700  IF BACKF=0 THEN 4800
  471. 4710    PUT@A (0,0)-(319,239),B%
  472. 4720    FOR SI=63 TO SPKOU STEP -1
  473. 4730      IF MOU%(SI) THEN 4750
  474. 4740        SORJJ%(SI)=SORJJ%(SI)+64-SORM:GOSUB *TORI
  475. 4750    NEXT
  476. 4760    GOSUB *SAOPUT
  477. 4770    SYMBOL (91,88),"REVERSE PACK",3/2,3/4,,,,5
  478. 4780    SYMBOL (64*2+23,48*3+15),"32",5/4,5/10,,,,5
  479. 4790    WAIT 30:GOSUB *SAOBPUT
  480. 4800  '
  481. 4810  FOR N=0 TO 63
  482. 4820   GOMBJ%(N)=JJJ%(N):GOMBJJ%(N)=JJJJ%(N):JJJ%(N)=2:JJJJ%(N)=0
  483. 4830   EMITR%(N)=EMIT%(N):EMIT%(N)=0
  484. 4840  NEXT
  485. 4850  IF SINRO=0 THEN 4870
  486. 4860    ERASE JJJ%:DIM JJJ%(63)
  487. 4870  KETTEIS=1:BX=T%(3):BY=AABB:T%(3)=0:AABB=64
  488. 4880  FOR SI=0 TO 63
  489. 4890    IF MOU%(SI)=0 THEN
  490. 4900      NAME INDR$+"WTMENU"+RIGHT$(STR$(101+SI),2)+".TIF" AS "TMENU"+RIGHT$(STR$(101+SORJJ%(SI)),2)+".TIF"
  491. 4910      JJJ%(SORJJ%(SI))=0:IF SI=BX THEN T%(3)=SORJJ%(SI)
  492. 4920      IF SINRO+ABS((GOMBJ%(SI)-1)*(EMITR%(SI)-1))=0 THEN 
  493. 4930         IF SI=BY THEN AABB=SORJJ%(SI)
  494. 4940         IF BACKF=0 OR SI < SPKOU THEN GOSUB *TORI
  495. 4950         IF GOMBJ%(SI)=1 THEN
  496. 4960            JJJ%(SORJJ%(SI))=1:JJJJ%(SORJJ%(SI))=GOMBJJ%(SI)
  497. 4970         ELSE
  498. 4980            EMIT%(SORJJ%(SI))=1
  499. 4990         ENDIF
  500. 5000      ELSE
  501. 5010      ENDIF
  502. 5020    ELSE
  503. 5030    ENDIF
  504. 5040   IF SI MOD 2 THEN 5070
  505. 5050   GOSUB *W1:PUT@A (64*2,48*3)-(64*2+63,48*3+47),D%
  506. 5060   SYMBOL (64*2+23,48*3+15),RIGHT$(STR$(131-SI/2),2),5/4,5/10,,,,5
  507. 5070  NEXT
  508. 5080  PUT@A (0,0)-(319,239),B%
  509. 5090  GOSUB *LINEW
  510. 5100  GOSUB *MINIW
  511. 5110  GOSUB *MOUSUB:GOSUB *WM10:MOUSE 1,,,1:RETURN
  512. 5120  '
  513. 5130 *TORI
  514. 5140  SA=SI:A=SORJJ%(SI):GOSUB *BIRD:RETURN
  515. 5150  '
  516. 5160 *RANT
  517. 5170  PUT@A (0,0)-(319,239),B%:AABB=64
  518. 5180  SYMBOL (81,118),"RANDOM SELECT",3/2,3/4,[180,245,255],,,5:RETURN
  519. 5190  '
  520. 5200 *RANSUB 
  521. 5210  GOSUB *NEKO:GOSUB *HAAIS
  522. 5220  FOR N=0 TO 63
  523. 5230   IF JJJ%(N) - 2 THEN 
  524. 5240      JJJ%(N)=0:JJJJ%(N)=0
  525. 5250   ELSE
  526. 5260   ENDIF
  527. 5270   EMIT%(N)=0
  528. 5280  NEXT
  529. 5290  GOSUB *RANT:KETTEIR=0:PCFX=0:GOSUB *WM10
  530. 5300  GOSUB *MOU3
  531. 5310  WHILE KETTEIR - PCFX = 0
  532. 5320    '
  533. 5330    WWW=-1
  534. 5340    FOR N=0 TO 63
  535. 5350     IF JJJ%(N)=0 THEN
  536. 5360       WWW=WWW+1:JJRR%(WWW)=N
  537. 5370     ELSE
  538. 5380     ENDIF
  539. 5390    NEXT
  540. 5400    IF WWW=-1 THEN
  541. 5410       PCFX=-1
  542. 5420    ELSE
  543. 5430      GOSUB *LINEW:GOSUB *MINIW
  544. 5440      KARI=0:GOSUB *MOUCH:IF MOUCHEN > WWW THEN GOSUB *MOUSUB
  545. 5450      WHILE KARI=0
  546. 5460        A=INT(RND * (WWW+1)):A=JJRR%(A):IF MOU%(A)=0 THEN KARI=1
  547. 5470      WEND
  548. 5480      GOSUB *PIPIPI
  549. 5490    ENDIF
  550. 5500    '
  551. 5510    IF PCFX THEN 5640
  552. 5520      WAIT 55:MOUSE 1,,,0:SAOX=Y%(4,0):SAOY=Y%(4,1):GOSUB *SAOH
  553. 5530      GOSUB *SAOPUT:WAIT 35:GOSUB *SAOBPUT:WAIT 20
  554. 5540    LOAD@ INDR$+"TMENU"+RIGHT$(STR$(101+A),2)+".TIF"
  555. 5550    IF JJJ%(A)=2 THEN
  556. 5560      IF MOUSE(3,1) THEN
  557. 5570        PCFX=-1:GOTO 5640
  558. 5580      ELSE
  559. 5590      ENDIF
  560. 5600      WAIT 10:IF WWW > 0 THEN GOSUB *RANT
  561. 5610    ELSE
  562. 5620      KETTEIR=1:MOU%(A)=1
  563. 5630    ENDIF
  564. 5640  '
  565. 5650  WEND
  566. 5660  IF PCFX THEN
  567. 5670    GOSUB *PUTWL:GOSUB *WM10:MOUSE 1,,,1
  568. 5680  ELSE
  569. 5690  ENDIF
  570. 5700  RETURN
  571. 5710  '
  572. 5720 *PI1
  573. 5730  IF Y%(2,N) >= Y%(SPKOU,N) THEN Y%(2,N)=Y%(2,N)+1
  574. 5740  RETURN
  575. 5750 *PI2
  576. 5760  Y%(SPKOU,0)=Y%(SPKOU+N,0):Y%(SPKOU,1)=Y%(SPKOU-N,1):RETURN
  577. 5770  '
  578. 5780 *PIPIPI 
  579. 5790  Y%(0,0)=MOUSE(0) \ 40:Y%(0,1)=MOUSE(1) \ 30
  580. 5800  Y%(4,0)=A MOD 8:Y%(4,1)=A \ 8
  581. 5810  FOR N=0 TO 1
  582. 5820    Y%(2,N)=INT(RND*3)
  583. 5830    SPKOU=0:GOSUB *PI1
  584. 5840    SPKOU=4:GOSUB *PI1
  585. 5850    IF Y%(2,N) = Y%(0,N) THEN Y%(2,N)=Y%(2,N)+1
  586. 5860  NEXT
  587. 5870  N=2*INT(RND*2)-1
  588. 5880  SPKOU=1:GOSUB *PI2
  589. 5890  SPKOU=3:GOSUB *PI2
  590. 5900  FOR N=0 TO 4
  591. 5910    Y%(N,0)=Y%(N,0)*40+20:IF Y%(N,0) > 286 THEN Y%(N,0)=286
  592. 5920    Y%(N,1)=Y%(N,1)*30+15:IF Y%(N,1) > 206 THEN Y%(N,1)=206
  593. 5930  NEXT
  594. 5940  GOSUB *PISUB
  595. 5950  RETURN
  596. 5960  '
  597. 5970 *PISUB 
  598. 5980  FOR N=0 TO 3
  599. 5990   SX=ABS((Y%(N,0)-Y%(N+1,0))+(Y%(N,1)-Y%(N+1,1))) / 4
  600. 6000   FOR SI=0 TO SX
  601. 6010   IF PCFX THEN 6100
  602. 6020    IF MOUSE(3,1) THEN
  603. 6030      PCFX=-1:MOUSE 1,,,0
  604. 6040      GOTO 6100
  605. 6050    ELSE
  606. 6060    ENDIF
  607. 6070    BX=SI/SX:BY=(SX-SI)/SX
  608. 6080    MOUSE 1,Y%(N,0)*BY+Y%(N+1,0)*BX,Y%(N,1)*BY+Y%(N+1,1)*BX,1
  609. 6090    GOSUB *ZYOUTAIS:GOSUB *YUSASUB:GOSUB *W1
  610. 6100    '
  611. 6110   NEXT
  612. 6120  NEXT
  613. 6130  GOSUB *NEKO
  614. 6140  RETURN
  615. 6150  '
  616. 6160 *MOUSUB
  617. 6170  ERASE MOU%:DIM MOU%(63):RETURN
  618. 6180  '
  619. 6190 *MOUCH 
  620. 6200  MOUCHEN=0
  621. 6210  FOR N=0 TO 63 
  622. 6220   IF MOU%(N) THEN MOUCHEN=MOUCHEN+1
  623. 6230  NEXT 
  624. 6240  RETURN
  625. 6250  '
  626. 6260 *PEKE
  627. 6270  JJJ%(A)=0:GOSUB *NEKO:MOUSE 1,,,0
  628. 6280  EMIT%(A)=0:GOSUB *PUTWL:MOUSE 1,ICX,ICY,1:RETURN
  629. 6290  '
  630. 6300 *MNW
  631. 6310  SYMBOL (18,N),S$,1,1/2,,,,4:N=N+15:GOSUB *FSUB:RETURN
  632. 6320  '
  633. 6330 *MANU
  634. 6340  GOSUB *NEKO:MOUSE 1,,,0:GOSUB *LLL
  635. 6350  SAOX=136:SAOY=7:GOSUB *SAOPUT:GOSUB *SAOBPUT
  636. 6360  IF GRAFL=0 THEN SYMBOL (134,56),"SAORI CHYAN",2/3,2/3,[0,230,190]
  637. 6370  S$="ALL VIEWING       MIGI + MIGI + MIGI":N=70:COLOR ,,3:GOSUB *MNW
  638. 6380  S$="RANDOM SELECT     MIGI---":GOSUB *MNW
  639. 6390  S$="RANDOM SORT       MIGI + HIDARI":GOSUB *MNW
  640. 6400  S$="FORWARD PACK      MIGI + HIDARI---":GOSUB *MNW
  641. 6410  S$="REVERSE PACK      FOR.PACK + MIGI":COLOR ,,[180,255,255]
  642. 6420  GOSUB *MNW:S$="MINIATURE DRAG    HIDARI---":COLOR,,7:GOSUB *MNW
  643. 6430  S$="MINIATURE DELETE  MINI.DRAG + MIGI":GOSUB *MNW
  644. 6440  S$="PEKE DELETE       HIDARI---":GOSUB *MNW
  645. 6450  S$="VIEW SAVE & LOAD  MIGI+ MIGI+ HIDARI":COLOR ,,2:GOSUB *MNW
  646. 6460  S$="ASSHUKU           HIDARI---":GOSUB *MNW
  647. 6470  S$="ONLINE MANUAL     HIDARI---":COLOR ,,1:GOSUB *MNW:GOSUB *COLS 
  648. 6480  GOSUB *WM10
  649. 6490  GOSUB *SAOPUT:GOSUB *MOU3
  650. 6500  WHILE MOUSE(2,0)+MOUSE(2,1)=0
  651. 6510    IF RND < 1/50 THEN GOSUB *SAOB2PUT
  652. 6520    GOSUB *W1:IF RND < 1/20 THEN GOSUB *SAOPUT
  653. 6530  WEND
  654. 6540  GOSUB *SAOPUT:WAIT 35:GOSUB *SAOBPUT:N=1:WAIT 35
  655. 6550  GOSUB *WM10
  656. 6560  '
  657. 6570  IF MOUSE(3,0) *  MOUSE(3,1) THEN N=0
  658. 6580  IF N+GRAFL=0 THEN
  659. 6590    WAIT 15
  660. 6600    GOSUB *FLSUB:GOSUB *LDSUB
  661. 6610    PLAY OFF:LINE (136,7)-(185,54),PSET,[0,180,180],BF
  662. 6620    GOSUB *GRASUB2
  663. 6630    FOR A=0 TO 63:SA=A:GOSUB *BIRD:NEXT 
  664. 6640    GOSUB *ONSUB
  665. 6650    '
  666. 6660  ELSE
  667. 6670  ENDIF
  668. 6680  IF N=0 THEN 6490
  669. 6690  GOSUB *PUTWL:GOSUB *NEKO:MOUSE 1,ICX,ICY,1:RETURN
  670. 6700  '
  671. 6710 *FLSUB
  672. 6720  FLASH=FLASH+1:IF FLASH > 2 THEN FLASH=0
  673. 6730  RETURN
  674. 6740  '
  675. 6750 *BIRD
  676. 6760  PUT@A (320,0)-(359,29),C%,,,,,40*30*SA
  677. 6770  LINE (320,0)-(359,29),PSET,,B
  678. 6780  GET@A (320,0)-(359,29),C%,40*30*A:RETURN
  679. 6790  '
  680. 6800 *BINGO
  681. 6810  BING=BING+1:IF BING < 1600 THEN 6830
  682. 6820  BING=0:ICX=MOUSE(0):ICY=MOUSE(1):GOSUB *MANU
  683. 6830  RETURN
  684. 6840  '
  685. 6850 *SAOH
  686. 6860  IF SAOX > 272 THEN SAOX=272
  687. 6870  IF SAOY > 190 THEN SAOY=190
  688. 6880  RETURN
  689. 6890  '
  690. 6900 *MASU
  691. 6910  MOMOMO=MOUSE(2,1)
  692. 6920  WHILE MOMOMO=0
  693. 6930   GOSUB *ZYOUTAIS:GOSUB *YUSASUB:GOSUB *BINGO:GOSUB *W1
  694. 6940   IF MOUSE(2,0) THEN
  695. 6950       ICX=MOUSE(4,0):ICY=MOUSE(5,0):BING=0
  696. 6960       A=(ICX \ 40) + (ICY \ 30)*8:RRR=0
  697. 6970          RRR=RRR+1:GOSUB *W1
  698. 6980            IF MOUSE(2,0)=0 THEN 7060
  699. 6990          IF RRR < 70 THEN 6970
  700. 7000            IF EMIT%(A) THEN 7040
  701. 7010            ON JJJ%(A)+1 GOTO 7020,7040,7030
  702. 7020               GOSUB *MANU:GOTO 7600
  703. 7030               GOSUB *PEKE:GOSUB *WM10:GOTO 7600
  704. 7040               GOSUB *KOUKAN
  705. 7050          GOTO 7600
  706. 7060       MOUSE 1,,,0:SAOX=ICX:SAOY=ICY:GOSUB *SAOH:GOSUB *NEKO
  707. 7070       GOSUB *SAOPUT:WAIT 20:GOSUB *SAOBPUT
  708. 7080       SUZITA=70
  709. 7090       IF A=AABB THEN
  710. 7100          IF JJJJ%(A) THEN
  711. 7110            SCREEN@ 0
  712. 7120            LOAD@ INDR$+"TMENU"+RIGHT$(STR$(101+A),2)+".TIF":MDNB=0 
  713. 7130          ELSE
  714. 7140            WAIT 20:PUT@A (0,0)-(319,239),B%
  715. 7150          ENDIF
  716. 7160       ELSE
  717. 7170          IF JJJ%(A) = 2 THEN
  718. 7180            GOSUB *NOSUB
  719. 7190          ELSE
  720. 7200            IF JJJJ%(A) THEN
  721. 7210              SCREEN@ 0:MDNB=0
  722. 7220            ELSE
  723. 7230            ENDIF
  724. 7240          LOAD@ INDR$+"TMENU"+RIGHT$(STR$(101+A),2)+".TIF"
  725. 7250          ENDIF
  726. 7260       ENDIF
  727. 7270       IF JJJ%(A) - 2 THEN 
  728. 7280         GOSUB *GETSUB:AABB=A
  729. 7290       ELSE 
  730. 7300       ENDIF
  731. 7310        MOMO = MOUSE(2,1)
  732. 7320        WHILE MOMO=0
  733. 7330         IF MOUSE(2,0) THEN
  734. 7340          IF JJJ%(A)=2 THEN
  735. 7350            MOMO=-1:GOTO 7480
  736. 7360          ELSE
  737. 7370          ENDIF
  738. 7380          T%(3)=A:SVFLG=1
  739. 7390            GOSUB *AA0S
  740. 7400              IF AA0 < 100 THEN
  741. 7410                BM1=1:GOSUB *HAAIS
  742. 7420              ELSE
  743. 7430              ENDIF
  744. 7440          MOMO=-1:MOMOMO=-1:GOTO 7480
  745. 7450         ELSE
  746. 7460         ENDIF
  747. 7470         GOSUB *FSUB:MOMO = MOUSE(2,1)
  748. 7480         '
  749. 7490        WEND
  750. 7500       IF JJJ%(A)=2 THEN PUT@A (0,0)-(319,239),B%
  751. 7510       IF MOMOMO THEN 7620 
  752. 7520       GOSUB *LINEW 
  753. 7530       GOSUB *MINIW
  754. 7540       IF JJJ%(A)=0 THEN GOSUB *PUB
  755. 7550       MOUSE 1,ICX,ICY,1:GOSUB *WM10
  756. 7560   ELSE
  757. 7570       OSUZITA=SUZITA:SUZITA=(MOUSE(0) \ 40) + (MOUSE(1) \ 30)*8
  758. 7580       IF OSUZITA - SUZITA THEN GOSUB *SUZIT
  759. 7590   ENDIF 
  760. 7600  '
  761. 7610  MOMOMO=MOUSE(2,1)
  762. 7620  '
  763. 7630  WEND
  764. 7640  MOUSE 1,,,0:RETURN
  765. 7650  '
  766. 7660 *SUZIT
  767. 7670  IF OSUZITA=70 THEN 7710
  768. 7680  IF JJJ%(OSUZITA) - 1 THEN 7710
  769. 7690  LX=OSUZITA MOD 8:LY=OSUZITA \ 8:GOSUB *XBYB
  770. 7700  PUT@A (XB,YB)-(XB+39,YB+29),C%,,,,,40*30*OSUZITA
  771. 7710  IF JJJ%(SUZITA) - 1 THEN 7740
  772. 7720  LX=SUZITA MOD 8:LY=SUZITA \ 8:GOSUB *XBYB
  773. 7730  SYMBOL (XB+17,YB+2),RIGHT$(STR$(SUZITA+101),2),5/4,5/10,,,,5
  774. 7740  RETURN
  775. 7750  '
  776. 7760 *MINIW
  777. 7770  FOR N=0 TO 63
  778. 7780  LX=N MOD 8:LY=N \ 8:GOSUB *XBYB:GOSUB *FSUB
  779. 7790    IF JJJ%(N) THEN
  780. 7800      IF JJJ%(N)=1 THEN 
  781. 7810        PUT@A (XB,YB)-(XB+39,YB+29),C%,,,,,40*30*N
  782. 7820      ELSE
  783. 7830        IF GSMS=0 THEN GOSUB *LINEC
  784. 7840      ENDIF
  785. 7850    ELSE 
  786. 7860    ENDIF
  787. 7870    IF EMIT%(N)=0 THEN 7900
  788. 7880    IF MINIF=0 THEN PUT@A (XB,YB)-(XB+39,YB+29),C%,PASTEL,,,,40*30*N
  789. 7890    IF GSMS THEN PUT@A (XB,YB)-(XB+39,YB+29),C%,,,,,40*30*N
  790. 7900  NEXT
  791. 7910  RETURN
  792. 7920  '
  793. 7930 *MKESI
  794. 7940  IF A=AABB THEN AABB=64
  795. 7950  MOUSE 1,,,0:JJJ%(A)=0:JJJJ%(A)=0:KESI=1
  796. 7960  EMIT%(A)=0:GOSUB *PUTWL:GOSUB *WM10
  797. 7970  RETURN
  798. 7980  '
  799. 7990 *KOUM
  800. 8000  KOUX=MOUSE(0)-20:KOUY=MOUSE(1)-15:SPKOU=0:RETURN
  801. 8010  '
  802. 8020 *KOUPUT
  803. 8030  IF JJJ%(A)=1 THEN
  804. 8040    PUT@A (KOUX,KOUY)-(KOUX+39,KOUY+29),C%,,,,,40*30*A
  805. 8050  ELSE
  806. 8060    PUT@A (KOUX,KOUY)-(KOUX+39,KOUY+29),C%,PASTEL,,,,40*30*A
  807. 8070  ENDIF
  808. 8080  RETURN
  809. 8090  '
  810. 8100 *KOUKAN
  811. 8110  GOSUB *NEKO:GOSUB *MOUSUB
  812. 8120  GOSUB *KOUM:KESI=0
  813. 8130  GET@A (KOUX,KOUY)-(KOUX+39,KOUY+29),D%
  814. 8140  GOSUB *KOUPUT:GOSUB *HAAIS
  815. 8150  WHILE KESI+MOUSE(2,0)=-1
  816. 8160    GOSUB *ZYOUTAIS:GOSUB *YUSASUB:GOSUB *W1
  817. 8170    IF SPKOU > 5 THEN
  818. 8180      OKOUX=KOUX:OKOUY=KOUY:GOSUB *KOUM
  819. 8190      IF ABS(KOUX-OKOUX)+ABS(KOUY-OKOUY) THEN
  820. 8200        PUT@A (OKOUX,OKOUY)-(OKOUX+39,OKOUY+29),D%
  821. 8210        GET@A (KOUX,KOUY)-(KOUX+39,KOUY+29),D%
  822. 8220        GOSUB *KOUPUT
  823. 8230      ELSE
  824. 8240      ENDIF
  825. 8250    ELSE
  826. 8260    ENDIF
  827. 8270     SPKOU=SPKOU+1:IF MOUSE(2,1) THEN GOSUB *MKESI
  828. 8280  WEND
  829. 8290  SAKIX=MOUSE(0):SAKIY=MOUSE(1):IF KESI THEN 8660
  830. 8300  SA=(SAKIX \ 40) + (SAKIY \ 30)*8 
  831. 8310  PUT@A (KOUX,KOUY)-(KOUX+39,KOUY+29),D%
  832. 8320  IF SA=A THEN 8670
  833. 8330  MOUSE 1,,,0 
  834. 8340  '
  835. 8350  N=1
  836. 8360  WTMENUF=1:W00F=1
  837. 8370  NAME INDR$+"TMENU"+RIGHT$(STR$(101+SA),2)+".TIF" AS "WTMENU00.TIF"
  838. 8380  WTMENUF=0:W00F=0
  839. 8390  '
  840. 8400  GOSTF=1
  841. 8410  NAME INDR$+"TMENU"+RIGHT$(STR$(101+A),2)+".TIF" AS "TMENU"+RIGHT$(STR$(101+SA),2)+".TIF" 
  842. 8420  GOSTF=0
  843. 8430  '
  844. 8440  IF N=1 THEN NAME INDR$+"WTMENU00.TIF" AS "TMENU"+RIGHT$(STR$(101+A),2)+".TIF"
  845. 8450  PUT@A (320,48)-(359,48+29),C%,,,,,40*30*A
  846. 8460  GOSUB *BIRD
  847. 8470  GET@A (320,48)-(359,48+29),C%,40*30*SA
  848. 8480  IF A=T%(3) THEN 
  849. 8490     T%(3)=SA
  850. 8500  ELSE 
  851. 8510     IF SA=T%(3) THEN T%(3)=A
  852. 8520  ENDIF
  853. 8530  IF AABB=A  THEN
  854. 8540     AABB=SA
  855. 8550  ELSE
  856. 8560     IF AABB=SA THEN AABB=A
  857. 8570  ENDIF
  858. 8580  SWAP JJJJ%(SA),JJJJ%(A):SWAP JJJ%(SA),JJJ%(A)
  859. 8590  MINIF=1:SWAP EMIT%(SA),EMIT%(A)
  860. 8600  IF ABS(JJJ%(A)-1)+ABS(JJJ%(SA)-1) THEN
  861. 8610    PUT@A (0,0)-(319,239),B%:GOSUB *LINEW:MINIF=0
  862. 8620  ELSE
  863. 8630  ENDIF
  864. 8640  GOSUB *MINIW:MINIF=0
  865. 8650  A=SA
  866. 8660  GOSUB *NEKO:MOUSE 1,SAKIX,SAKIY,1
  867. 8670  KESI=0
  868. 8680  RETURN
  869. 8690  '
  870. 8700 *MODCH
  871. 8710  IF MDNB=0 THEN
  872. 8720    GOSUB *WIN:MDNB=1
  873. 8730    PUT@A (0,0)-(319,239),B%,PSET,2
  874. 8740    GET@A (0,0)-(319,239),B%:GOSUB *NEKO
  875. 8750  ELSE
  876. 8760  ENDIF
  877. 8770  RETURN
  878. 8780  '
  879. 8790 *LINEW
  880. 8800  GOSUB *MODCH
  881. 8810  FOR LX=0 TO 7 
  882. 8820   FOR LY=0 TO 7
  883. 8830   GOSUB *LINEB:GOSUB *XBYB
  884. 8840   SYMBOL (XB+17,YB+2),RIGHT$(STR$(LX+LY*8+101),2),5/4,5/10,,,,5
  885. 8850   NEXT
  886. 8860  NEXT
  887. 8870  RETURN
  888. 8880  '
  889. 8890 *PUB
  890. 8900  LX=A MOD 8:LY=A \ 8:GOSUB *XBYB
  891. 8910   IF JJJ%(A) - 2 THEN
  892. 8920     JJJ%(A)=1:MOU%(A)=1:PUT@A (XB,YB)-(XB+319,YB+239),B%,,1/8,1/8
  893. 8930     EMIT%(A)=0:GOSUB *LINEB:GET@A (XB,YB)-(XB+39,YB+29),C%,40*30*A
  894. 8940   ELSE
  895. 8950     GOSUB *LINEC
  896. 8960   ENDIF
  897. 8970  RETURN
  898. 8980  '
  899. 8990 *XBYB
  900. 9000  XB=LX*40:YB=LY*30:RETURN
  901. 9010 *XBYBG
  902. 9020  XB=LX*64:YB=LY*48:RETURN
  903. 9030  '
  904. 9040 *LINEB
  905. 9050  LINE (LX*40,LY*30)-(LX*40+39,LY*30+29),PSET,,B:RETURN
  906. 9060  '
  907. 9070 *LINEC
  908. 9080  LINE (LX*40,LY*30)-(LX*40+39,LY*30+29),PSET
  909. 9090  LINE (LX*40,LY*30+29)-(LX*40+39,LY*30),PSET:RETURN
  910. 9100  '
  911. 9110 *LINES
  912. 9120  LINE (LX*64+1,LY*48)-(LX*64+64-2,LY*48+48-3),PSET,,B:RETURN
  913. 9130  '
  914. 9140 *SETTEI
  915. 9150  WAIT 120:GOSUB *LLL
  916. 9160  FOR LY=1 TO 2
  917. 9170   FOR LX=0 TO 4
  918. 9180    GOSUB *XBYBG:LINE (XB+1,YB)-(XB+62,YB+45),PSET,3,BF
  919. 9190    SYMBOL (XB+8,YB+17),MID$("DRIVE ADRIVE B       DRIVE DDRIVE EDRIVE FDRIVE GDRIVE HDRIVE IDRIVE J",((LY-1)*5+LX)*8+1,8),4/5,5/6,[0,200,190],,,5
  920. 9200   NEXT 
  921. 9210  NEXT 
  922. 9220    SYMBOL (64+40,48*4),"背景出力先を選んでね!",2/3,2/3,7,,,4
  923. 9230    SYMBOL (64*2+17,62),"<EXIT>",2/3,1,7,,,4 
  924. 9240    LX=3:LY=1:COLOR ,,7:GOSUB *LINES
  925. 9250    MOUSE 1,64*2+32,80,1:MOUSE 4,2,49,318,140
  926. 9260    GOSUB *ZYOUTAIS:GOSUB *YUSASUB:GOSUB *W1
  927. 9270    IF MOUSE(2,0) THEN
  928. 9280      A=(MOUSE(4,0) \ 64) + ((MOUSE(5,0) \ 48)-1)*5 + 1
  929. 9290      '
  930. 9300      IF A=3 THEN 9380
  931. 9310      LX=((T%(1)-1) MOD 5):LY=((T%(1)-1) \ 5)+1:COLOR ,,3:GOSUB *LINES
  932. 9320      T%(1)=A:LX=((A-1) MOD 5):LY=((A-1) \ 5)+1:COLOR ,,7:GOSUB *LINES
  933. 9330      GOSUB *NEKO:GOSUB *HAAIS
  934. 9340      GOSUB *WM10
  935. 9350    ELSE
  936. 9360    ENDIF 
  937. 9370    GOTO 9260
  938. 9380    MOUSE 1,,,0:MOUSE 4,0,0,319,239:GOSUB *WM10
  939. 9390    GOSUB *NEKO
  940. 9400    SAOX=162:SAOY=58:GOSUB *SAOPUT:WAIT 35:GOSUB *SAOBPUT:WAIT 80
  941. 9410  GOSUB *COLS:RETURN
  942. 9420  '
  943. 9430 *NEKO
  944. 9440  NUKU=0:JUNK=1:MOUSE 6,1,MSA1%,MSD1%:RETURN
  945. 9450  '
  946. 9460 *NOSUB
  947. 9470  LINE (0,0)-(319,239),PSET,[190,230,230],BF
  948. 9480  SYMBOL (124,115),"NODATA",3/2,3/4,[170,210,210],,,5:RETURN
  949. 9490  '
  950. 9500 *LLL
  951. 9510  LINE (0,0)-(319,239),PSET,[0,180,180],BF:RETURN
  952. 9520  '
  953. 9530 *ERTRP
  954. 9540  IF ERR=63 THEN
  955. 9550         IF W00F THEN
  956. 9560            N=2:JJJ%(SA)=2:EMIT%(SA)=0:RESUME NEXT
  957. 9570         ELSE
  958. 9580         ENDIF
  959. 9590         IF KILBN THEN RESUME NEXT
  960. 9600         IF VIFF THEN RESUME 3640
  961. 9610         IF DATF=1 THEN
  962. 9620            T%(1)=4:DATF=2:RESUME 150
  963. 9630         ELSE
  964. 9640         ENDIF
  965. 9650         IF SORFLG THEN
  966. 9660            MOU%(SI)=1:RESUME NEXT 
  967. 9670         ELSE
  968. 9680         ENDIF
  969. 9690         IF FLASHF THEN
  970. 9700            GOSUB *FLSUB
  971. 9710            IF ABS(FLASH-T%(2))+ABS(GRAFL-1)=0 THEN
  972. 9720              SYMBOL (320,100),"●",1,1,[20,230,170]
  973. 9730              SYMBOL (332,100),"●",1,1,[20,230,170]
  974. 9740              SYMBOL (326,108),"◆",1,1,[20,230,170]
  975. 9750              SYMBOL (317,97),"・",1,1,[180,230,200]
  976. 9760              GET@A (320,100)-(359,139),D%
  977. 9770              PUT@A (320,0)-(359,39),D%,,1/2,1/2
  978. 9780              F14=31:F15=31
  979. 9790              FLASH=0:GRAFL=2:RESUME 1470
  980. 9800            ELSE
  981. 9810            ENDIF
  982. 9820            RESUME
  983. 9830         ELSE
  984. 9840         ENDIF
  985. 9850         IF SOUFL=1 THEN
  986. 9860            ERASE HAAI%:SOUFL=2:RESUME 1740
  987. 9870         ELSE
  988. 9880         ENDIF
  989. 9890         IF GOSTF THEN
  990. 9900            EMIT%(A)=0:JJJ%(A)=2:RESUME NEXT
  991. 9910         ELSE
  992. 9920         ENDIF
  993. 9930    GOSUB *NOSUB
  994. 9940    JJJ%(A)=2:EMIT%(A)=0:RESUME NEXT 
  995. 9950  ELSE
  996. 9960  ENDIF
  997. 9970  IF (ERR-65)*(ERR-67)+ABS(VIEWFL-1)=0 THEN
  998. 9980    VIEWFL=2:RESUME NEXT
  999. 9990  ELSE
  1000. 10000  ENDIF
  1001. 10010  '
  1002. 10020  S$="ERR"+STR$(ERR)  '+"   GYOU"+STR$(ERL)
  1003. 10030  '
  1004. 10040  IF ERR=112 THEN
  1005. 10050    IF MDNB THEN
  1006. 10060      SCREEN@ 0:MDNB=0:JJJJ%(A)=1:RESUME
  1007. 10070    ELSE
  1008. 10080      S$="16色か3万色に!"
  1009. 10090    ENDIF
  1010. 10100  ELSE
  1011. 10110  ENDIF
  1012. 10120  GOSUB *WIN
  1013. 10130  GOSUB *LLL:PLAY OFF
  1014. 10140  E1=ERR
  1015. 10150  IF (E1-53)*(E1-55)*(E1-60)*(E1-72)*(E1-73)*(E1-75)=0 THEN S$="ディスクが変!"
  1016. 10160  IF (ERR-65)*(ERR-67)=0 THEN S$="ディスク満杯!"
  1017. 10170  IF (E1-7)*(E1-14)*(E1-82)*(E1-83)*(E1-89)=0 THEN S$="メモリ不足!"
  1018. 10180  IF ABS(ERR-64)+ABS(WTMENUF-1)=0 THEN S$="ワークファイルがある!"
  1019. 10190  SYMBOL (80,100),S$,1,1,3,,,5:WAIT 180:RESUME 1000
  1020.